perm filename HEAP.SAI[1,BGB]2 blob
sn#090785 filedate 1974-03-12 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00002 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 BEGIN "HEAP SORT"
C00004 ENDMK
C⊗;
BEGIN "HEAP SORT"
REQUIRE "ABBREV[SYS,BGB]" SOURCE_FILE;
REQUIRE "RANDOM[SYS,BGB]" SOURCE_FILE;
REQUIRE "TIMER[SYS,BGB]" SOURCE_FILE;
INTEGER ARRAY A[1:10000];
PROCEDURE HEAPSORT (INTEGER ARRAY A; INTEGER N);
BEGIN "HEAPSORT"
INTEGER I,J,K;
INTEGER X,Q;
α PHASE ONE, PUT 'EM UNDER THE HEAP & BIGGIES TRICKLE UP;
FOR K←2 STEP 1 UNTIL N DO
BEGIN
I←K;
X←A[K];
WHILE I>1 ∧ X>A[J←I%2] DO
BEGIN A[I]←A[J]; I←J END;
A[I]←X;
END;
α PHASE TWO, TAKE 'EM OFF THE TOP & PROMOTE SUBORDINATES;
FOR K←N STEP -1 UNTIL 2 DO
BEGIN
X←A[K];A[K]←A[1];I←1;
WHILE (J←2*I)<K DO
BEGIN
IF A[J+1]>A[J] ∧ (J+1)<K THEN J←J+1;
IF X≥A[J] THEN DONE ELSE
BEGIN A[I]←A[J];I←J;END;
END;
A[I]←X;
END;
END "HEAPSORT";
INTEGER Q;
FOR Q←1 STEP 1 UNTIL 1000 DO A[Q]←1000*RANDOM;
INTIME;
HEAPSORT(A,1000);
FOR Q←1 STEP 1 UNTIL 1000-1 DO
IF A[Q]>A[Q+1] THEN BEGIN OUTSTR("SORT ERROR ! ");INCHRW;END;
OUTIME;
INCHRW;
END "HEAP SORT";